home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / crypt.tcl.z / crypt.tcl
Text File  |  2002-07-08  |  2KB  |  68 lines
  1. #
  2. # crypt.tcl
  3. #    Generalized sypport for multipart/signed and multipart/encrypted
  4. #    in exmh.
  5. #
  6. #    Written by Chris Garrigues
  7.  
  8. proc Crypt_Init {} {
  9.     global mime
  10.  
  11.     set protocols [concat [option get . sigProts {}] [option get . sigUProts {}]]
  12.     Exmh_Debug sigProtocols $protocols
  13.     set mime(showsig,default)            Mime_ShowMultipart
  14.     if {[llength $protocols] == 0} {
  15.     set mime(showsig,application/pgp-signature)    Pgp_MimeShowMultipartSignedPgp
  16.     } else {
  17.     foreach protocol $protocols {
  18.         set func [option get . sig_$protocol {}]
  19.         if {[string length $func] != 0} {
  20.         set mime(showsig,$protocol) $func
  21.         }
  22.     }
  23.     }
  24.     set protocols [concat [option get . cryptProts {}] [option get . cryptUProts {}]]
  25.     Exmh_Debug cryptProtocols $protocols
  26.     set mime(showcrypt,default)            Mime_ShowMultipart
  27.     if {[llength $protocols] == 0} {
  28.     set mime(showcrypt,application/pgp-encrypted)    Pgp_MimeShowMultipartEncryptedPgp
  29.     } else {
  30.     foreach protocol $protocols {
  31.         set func [option get . crypt_$protocol {}]
  32.         if {[string length $func] != 0} {
  33.         set mime(showcrypt,$protocol) $func
  34.         }
  35.     }
  36.     }
  37. }
  38.  
  39. proc MimeShowMultipartSigned {tkw part} {
  40.     global mimeHdr mime
  41.  
  42.     set protocol $mimeHdr($part,param,protocol)
  43.     
  44.     if [info exists mime(showsig,$protocol)] {
  45.     if [catch {$mime(showsig,$protocol) $tkw $part} err] {
  46.         Exmh_Status "Error decoding $protocol: $err"
  47.         $mime(showsig,default) $tkw $part
  48.     }
  49.     } else {
  50.     Exmh_Status "Unknown signature protocol: $protocol"
  51.     $mime(showsig,default) $tkw $part
  52.     }
  53. }
  54.  
  55. proc MimeShowMultipartEncrypted {tkw part} {
  56.     global mimeHdr mime
  57.  
  58.     set protocol $mimeHdr($part,param,protocol)
  59.  
  60.     if [info exists mime(showcrypt,$protocol)] {
  61.     $mime(showcrypt,$protocol) $tkw $part
  62.     } else {
  63.     Exmh_Status "Unknown encryption protocol: $protocol"
  64.     $mime(showcrypt,default) $tkw $part
  65.     }
  66. }
  67.  
  68.